00100	TITLE GEOMED  -  GEOMETRIC EDITOR  -  JANUARY 1973.
00200	
00300	COMMENT/	CONTENTS:
00400	
00500		1. START, REENTER, GEOMED TOP LISTEN LOOP.
00600		2. GEOMETRIC EDITOR STATE VECTOR.
00700		3. TELETYPE COMMAND JUMP TABLE.
00800		4. STATE DISPLAY.
00900	
01000	/
01100		EXTERN WORLD
01200	;EDITOR STATE.
01300	
01400		PDLPTR:	IOWD 100,PADPDL
01500		PADPDL:	BLOCK 100
01800	
01900		DECLARE{CHR,CTRL,META,ALPHA,BETA,EPSILN}
02000		DECLARE{TDEL,DDEL,RDEL}
02100		DECLARE{OPERAT,FRAME,FRMORG,AXECNT,ITERAT}
     

00100	;INITIALIZATION FOR STAND ALONE GEOMED.---------------------------
00200		OPDEF PPIOT[702B8]
00300		PDL: BLOCK 100
00400	
00500	;START ADDRESS
00600	SA:	JFCL
00700		CALL(CREAT1)	;CREATION TYPE-1.
00800	
00900	;RE-ENTRY ADDRESS.
01000	REE:	LACI .↔DAC 124
01100		PPIOT 2,-=250↔PPIOT 3,3003
01200		LAC 17,[IOWD 100,PDL]
01300		CALL(GEOMED)
01400		CALLI 12
01500	;1/12/73----------------------------------------------------------
01600	
01700	SUBR(GEOMED)------------------------------------------------------
01800	BEGIN GEOMED;GEOMETRIC EDITOR TOP LISTEN LOOP - BGB - 1/12/73.
01900	
02000	L:	CALL(STADPY)
02100		CALL(TTY)
02200		GO L
02300	
02400	BEND;1/12/73------------------------------------------------------
02500	
02600	SUBR(DPYSUB)------------------------------------------------------
02700	BEGIN DPYSUB;GEOMED DISPLAY REFRESH SUBROUTINE - BGB - 1/15/73.
02800		POP0J
02900	BEND;1/12/73------------------------------------------------------
     

00100	SUBR(CREAT1)------------------------------------------------------
00200	BEGIN CREAT1;CREATION OF THE UNIVERSE TYPE-1.
00300	;BGB - 13 JANUARY 1973.
00400		CALL(MORCOR)
00500		SETQ(WORLD,{MAKE,[0]})
00600		LAC 2,UNIVERSE↔DAP 1,-2(2)	;REALITY WORLD MODEL.
00700		DIP 1,1↔DAC 1,-3(1)		;EMPTY BODY RING.
00800		LAC[ASCII/REALI/]↔DAC 4(1)
00900		LAC[ASCIZ/TY/]↔DAC 5(1)
01000		POP0J
01100	BEND;1/13/73------------------------------------------------------
     

00100	SUBR(STADPY)------------------------------------------------------
00200	BEGIN STADPY;STATUS DISPLAY - BGB - 1/12/73
00300		CALL(DPYSET,DPYBUF)
00400		CALL(AIVECT,[-=511],[-=384])
00500		CALL(AVECT,[ =511],[-=384])
00600		CALL(AVECT,[ =511],[ =384])
00700		CALL(AVECT,[-=511],[ =384])
00800		CALL(AVECT,[-=511],[-=384])
00900		CALL(DPYOUT,[0])
01000		POP0J
01100	BEND;1/12/73------------------------------------------------------
     

00100	SUBR(TTY)---------------------------------------------------------
00200	BEGIN TTY;CAREYE TELETYPE COMMAND JUMP TABLE  -BGB-  NOVEMBER 1972.
00300	L0:	CRLF
00400	L1:	OUTCHR["*"]
00500	L2:	INCHRW
00600		SETZM CTRL↔TRZE 200↔SETOM CTRL
00700		SETZM META↔TRZE 400↔SETOM META
00800		CAIN 0,15↔GO L2
00900		CAIN 0,12↔GO L1
01000		DAC 0,CHR
01100	
01200	;READ JUMP TABLE.
01300		DAC 0,1
01400		CAIG 0,140↔GO[LAC 1,A00(1)↔GO L3]
01500		CAIG 0,172↔GO[LAC 1,A00-40(1)↔GO L3]
01600		LAC 1,A173-173(1)
01700	L3:	PUSHJ P,(1)↔GO L2↔GO L0
01800		LIT
01900	BEND;1/12/73------------------------------------------------------
02000	
02100	NOP:	OUTCHR CHR↔CRLF↔POP0J
     

00100	;ASCII 00 TO 37--------------------------------------------------
00200	
00300	A00:	NOP   ;null.
00400		NOP   ;"↓"
00500		NOP   ;"α"
00600		NOP   ;"β"
00700	
00800		NOP   ;"∧"
00900		NOP   ;"¬"
01000		NOP   ;"ε"
01100		NOP   ;"π"
01200	
01300		NOP   ;"λ"
01400		NOP   ;TAB.
01500		NOP   ;LF.
01600		NOP   ;VT.
01700	
01800		NOP   ;FF.
01900		NOP   ;CR.
02000		NOP   ;"∞"
02100		NOP   ;"∂"
02200	
02300		NOP   ;"⊂"
02400		NOP   ;"⊃"
02500		NOP   ;"∩"
02600		NOP   ;"∪"
02700	
02800		NOP   ;"∀"
02900		NOP   ;"∃"
03000		NOP   ;"⊗"
03100		NOP   ;"↔"
03200	
03300		NOP   ;"_"
03400		NOP   ;"→"
03500		NOP   ;TILDE
03600		NOP   ;"≠"
03700	
03800		NOP   ;"≤"
03900		NOP   ;"≥"
04000		NOP   ;"≡"
04100		NOP   ;"∨"
04200	
04300	;----------------------------------------------------------------
     

00100	;ASCII 40 TO 100-------------------------------------------------
00200	
00300		NOP   ;SPACE
00400		NOP   ;"!"
00500		NOP   ;"""
00600		NOP   ;"#"
00700	
00800		NOP   ;"$"
00900		NOP   ;"%"
01000		NOP   ;"&"
01100		NOP   ;"'"
01200	
01300		EUTRAN;"("	EUCLIDEAN TRANSFORMATION -Y.
01400		EUTRAN;")"	EUCLIDEAN TRANSFORMATION +Y.
01500		EUTRAN;"*"	EUCLIDEAN TRANSFORMATION +Z.
01600		NOP   ;"+"
01700	
01800		NOP   ;","
01900		EUTRAN;"-"	EUCLIDEAN TRANSFORMATION -Z.
02000		NOP   ;"."
02100		NOP   ;"/"
02200	
02300		NOP   ;"0"
02400		NOP   ;"1"
02500		NOP   ;"2"
02600		NOP   ;"3"
02700	
02800		NOP   ;"4"
02900		NOP   ;"5"
03000		NOP   ;"6"
03100		NOP   ;"7"
03200	
03300		NOP   ;"8"
03400		NOP   ;"9"
03500		EUTRAN;":"	EUCLIDEAN TRANSFORMATION -X.
03600		EUTRAN;";"	EUCLIDEAN TRANSFORMATION +X.
03700	
03800		NOP   ;"<"
03900		NOP   ;"="
04000		NOP   ;">"
04100		NOP   ;"?"
04200	
04300		NOP   ;"@"
04400	
04500	;----------------------------------------------------------------
     

00100	;ASCII 101 TO 132 UPPER CASE-------------------------------------
00200	;ASCII 141 TO 172 LOWER CASE.
00300	
00400	A101:	NOP   ;"A"
00500		NOP   ;"B"
00600		NOP   ;"C"
00700		NOP   ;"D"
00800	
00900		SWIRE ;"E"
01000		NOP   ;"F"
01100		NOP   ;"G"
01200		NOP   ;"H"
01300	
01400		NOP   ;"I"
01500		NOP   ;"J"
01600		NOP   ;"K"
01700		NOP   ;"L"
01800	
01900		NOP   ;"M"
02000		NOP   ;"N"
02100		NOP   ;"O"
02200		NOP   ;"P"
02300	
02400		NOP   ;"Q"
02500		NOP   ;"R"
02600		NOP   ;"S"
02700		NOP   ;"T"
02800	
02900		NOP   ;"U"
03000		VBODY ;"V" MAKE VERTEX BODY.
03100		NOP   ;"W"
03200		NOP   ;"X"
03300	
03400		NOP   ;"Y"
03500		NOP   ;"Z"
03600	
03700	;ASCII 133 TO 140.
03800		NOP   ;"["
03900		NOP   ;"\"
04000		NOP   ;"]"
04100		NOP   ;"↑"
04200		NOP   ;"←"
04300		NOP   ;"`"
04400	
04500	;ASCII 173 TO 177.
04600	A173:	NOP   ;"{"
04700		NOP   ;"|"
04800		NOP   ;ALTMODE
04900		NOP   ;"}"
05000		NOP   ;RUBOUT
05100	
05200	;----------------------------------------------------------------